24300		TITLE METNUM	;	SUBROUTINE METER
24400		ENTRY METER,MAKNUM  ;COMMON R2,JA,CENTR,J2,RJQ(20),J3,JQ(19)/STF/RSTFAC(-3/4),RSTJ2
24500	METER:	0	;	COMMON/POSI/STFF(-3/4),JJ2,POS
24600	;	EQUIVALENCE (R4,RJQ(2)),(R7,RJQ(5)),(R6,RJQ(4)),(R5,RJQ(3))
24700	;	1,(R8,RJQ(6)),(RX3,RJQ(20)),(J10,JQ(7)),(J7,JQ(5)),(R9,RJQ(7))
24900	;  PARAMS  18 / STF / POS / VERT HGT./ TOP NUM/ BOT NUM/ SIZE FAC.
25100		SKIPN 1,.COMM.+=8		;	CALL NOZERO(R7)
25110		MOVSI 1,201400
25200		MOVE 13,.COMM.+=24	;  13 IS JZ=J3
25300		MOVSI 12,204400		;RY=R4+8.*R7
25310		FMPR 12,1
25320		FADR 12,.COMM.+5	; 12 IS RY
25400	;  HEIGHT
25500		MOVE 14,.COMM.+7	; 14 IS  RW=R6
25600	;  BOTTOM NUM
25700	;  P5=TOP NUM
25800		MOVEM 1,.COMM.+7	; (1 IS R7)  R6=R7
25900		MOVE 11,1		; 11 IS  RR6=R6
26000	;  SIZE
26100	;  FOR BDR40  -- OR =1
26200		SETZ 10,		; 10 IS M=0
26300		MOVEM 12,.COMM.+5	; R4=RY
26400		SETZM .COMM.+=8		;2	R7=0
26500	;  R7=0 FOR BDR FONT??
26700		MOVE .COMM.+6		;IF(R5.LT.90)GO TO 3
26800		CAMGE [90.0]  	;  99 AS METER = 'C'  98=ALLA BREVE (CUT TIME)
26850		JRST MET3
26900		SETO 10,		;M=-1
27000		CAME [98.0]		;IF(R5.NE.98)GO TO 4
27100		JRST MET4		; NEXT FOR LINE THROUGH C.
27200		MOVE .COMM.+7		;    RZ=R6
27250		MOVEM RZ#
27300		MOVE .COMM.+5		;  RY=R4
27350		MOVEM RY#
27400		MOVE STF+=9		;RA=POS
27450		MOVEM RA#
27500		MOVE .COMM.+=23		; R6=RX3
27550		MOVEM .COMM.+7		;TO LINE UP WITH R3
27700		MOVEI 2			;J10=2
27750		MOVEM .COMM.+=31	;FOR THICK LINE
28000		MOVN [3.8]		;R4=R4-3.8
28025		FADRM .COMM.+5
28050		FADR [5.6]		;R5=R4+5.6
28075		MOVEM .COMM.+6
28100		SETZM .COMM.+=28	;J7=0
28200		SETZM .COMM.+=9		;R8=0
28300		JSA 16,ITMSUB		;CALL ITMSUB
28400		MOVE RA			;POS=RA
28450		MOVEM STF+=9
28500		MOVE RY			;R4=RY
28550		MOVEM .COMM.+5
28600		MOVE RZ			;R6=RZ
28650		MOVEM .COMM.+7		;GET BACK THE RIGHT PARAMS.
28900	MET4:	MOVE [9999.0]		;4	R5=9999.
28950		MOVEM .COMM.+6		;TO CENTER 12S AND 16S
29200	3	CALL MAKNUM(R5)
29300		IF(M)RETURN
29400	C  STICK AROUND FOR BOTTOM NUM
29500		M=-1
29600		R4=RY-4.*RR6
29700		R6=RR6
29800		R5=RW
29900	C  GET BOTTOM NUM
30000		J3=JZ
30100		R8=0
30200		GO TO 2
30300		END
30400	
30500	CF	SUBROUTINE RNOTE(X)
30600	CF	COMMON /PTR/PWDS(250),ITEM,L,I,IX/XRN/RN(4000)
30700	CF	X=RN(IFIX(PWDS(IFIX(AMOD(X,1000.))))+2)
30800	CF	END
30900	
31000		SUBROUTINE MAKNUM(RNUM)
31100		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/STF/RSTFAC(-3/4),RSTJ2
31200		EQUIVALENCE (J3,JQ(1)),(R4,RJQ(2)),(R8,RJQ(6)),(R7,RJQ(5))
31300	     1,(R6,RJQ(4)),(R5,RJQ(3)),(R7,RJQ(5)),(JQ(15),B),(JQ(16),C)
31400		1 ,(J8,JQ(6)),(J10,JQ(8)),(R3,RJQ(1)),(J5,JQ(3)),(RJY,JQ(19))
31500		1 ,(J7,JQ(5)),(J6,JQ(4)),(R9,RJQ(7))
31600		DATA RS/10.0/,RBX/1.0/
31700		RB8=R8
31800		J3X=J3
31900	C P7=0=BDR40; =1=BDI40; =2=PRIM.
32000		CALL NOZERO(R6)
32100		R5=R6
32200	C  UPPER CASE - BDR40
32300		R6=48000000.0+(R7+50.)*10000.
32400		R7=99999999.0
32500	C  BLANKS
32600		R8=R7
32700		IF(RNUM.NE.9999.)GO TO 2
32800	C  NEXT FOR 'C'OMMON TIME
32900		RNUM=12.
33000	C  MAKES A 'C'
33100		R4=R4-2.2
33200	C  .2 FOR BAD POS. OF LETTERS
33300		GO TO 4
33400	
33500	2	ONE=0 
33600		RNUM=IFIX(RNUM)
33700	C  SO MISTAKES (i.e. 2.2) WON'T BREAK THE PROG.
33800		IF(RNUM.EQ.1.)ONE=3.
33900		IF(RNUM.GT.9.)GO TO 3
34000	C  JUMP FOR 2 OR 3 DIGIT NUMBER
34100	4	R6=R6+RNUM*100.+47.
34200	C  PUTS BLANK ON END (.47)
34300		GO TO 1
34400	
34500	3	RJY=10.
34600		IF(RNUM.GE.100.)RJY=100.
34700		B=IFIX(RNUM/RJY)
34800		C=AMOD(RNUM,RJY)
34900		IF(RNUM.LT.100)GO TO 7
35000		D=IFIX(C/10.)
35100		C=AMOD(C,10.)
35200		IF(C.EQ.1.)ONE=ONE+3.
35300		R7=C*1000000.+999999.0
35400		C=D
35500	7	R6=R6+B*100.+C
35600		IF(B.EQ.1.)ONE=ONE+3.
35700		IF(C.EQ.1.)ONE=ONE+3.
35800		B=R5
35900		IF(RNUM.GE.100.)B=B*2
36000		J3=J3-RS*RSTJ2*B
36100	C  FOR 2 DIGIT NUMBER
36200	CCC	IF(RNUM.GE.20.)GO TO 6
36300	CCC	IF(JA.EQ.18)GO TO 6
36400	CCC	RJY=5.6
36500	CCC	IF(RNUM.GT.11.)RJY=3.
36600	C  ADJUSTS FOR 11, ETC.
36700	CCC	J2=J2+RJY*R5*RSTJ2
36800	CC6	J3=J2
36900	1	J3=J3+ONE*R5*RSTJ2
37000	C CENTERS THE NUMBER '1'
37100		CALL ALPHA
37200		J3=J3X
37300		IF(RB8.EQ.0)RETURN
37400	C NEXT FOR CIRCLES AND BOXES AROUND NUMBERS.
37500		R3=J3-R5
37600		IF(J10.EQ.0)J10=1
37700	C  USE J10 FOR EVEN THICKER BOX AND CIRC.
37800		IF(RNUM.GT.9)R3=R3+R5*RBX
37900	C  TO SET CENTER
38000		IF(RB8.EQ.2)GO TO 5
38100		R4=R4+R5+.1+.05/R5
38200	C  END OF ABOVE IS FOR SMALL CIRCLES.
38300		B=4.5
38400		IF(RNUM.GE.100.)B=5.5
38500		R5=R5*B
38600		JA=12
38700		J6=0
38800		J7=0
38900		J8=J10
39000		CALL CENTX
39100		CALL SLUR
39200		RETURN
39300	
39400	5	JA=4
39500		B=6
39600		R9=0
39700		IF(RNUM.LT.100.)GO TO 8
39800		B=9.
39900		R9=R5*6.
40000	C  MAKES RECTANGLE IF ≥100
40100	8	R4=R4+R5*.7+.1
40200		R8=R5*B
40300		J5=50
40400		CALL ITMSUB
40500	C  RETURNS ORIG. HORIZ. POS.
40600		END
40700	C  MAKES ONLY 1 TO 3 DIGIT NUMS NOW.  EXPAND LATER.
40800	
40900	CC	FUNCTION IABS(N)
41000	C  BECAUSE IABS IN LIB40 HAS A BUG.
41100	CC	IABS=N
41200	CC	IF(N)IABS=-N
41300	CC	END
41400	
41500	CF	SUBROUTINE DRWNT(RMINI)
41600	CF	COMMON /STF/RSTFAC(-3/4),RSTJ2
41700	CF	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
41800	CF	EQUIVALENCE (JE,JQ(3)),(RJD,RJQ(2)),(R6,RJQ(4)),
41900	CF	1 (JG,JQ(5)),(R7,RJQ(5)),(RJE,RJQ(3)),(RJZ,RJQ(20))
42000	CF	1 ,(JI,JQ(7)),(R9,RJQ(7)),(JH,JQ(6))
42100	CF	RJX=CENTR
42200	CF	JH=0
42300	C  JH=0 SO IT WILL FILL. (P8 IN 'CLEFS')
42400	CC	CENTR=CENTR-21.*RSTJ2
42500	CF	RA=R6
42600	CF	R6=.5*RMINI/RSTJ2
42700	CF	R7=R6
42800	CF	RJD=RJZ-3
42900	CCXX	IF(RSTJ2.NE.RMINI)RJD=RJZ+.43*(RJZ-3.)-.3
43000	C  ADJUSTS POSITION FOR MINI ACCIDENTALS (..??!!)
43100	CF	JI=0
43200	CF	CALL CLEFS
43300	CF	JI=R9
43400	C  ↑↑↑↑↑↑ NEEDED??
43500	C  FIX THIS???? ↑↑↑↑↑
43600	C  FOR WHITE NOTES AND ACCIS ON PLOTTER.
43700	CF	CENTR=RJX
43800	CF	R6=RA
43900	CF	R7=JG
44000	CF	JE=RJE
44100	CF	END
44200	
44300	CC	FUNCTION RHORZ(R)
44400	CC	RHORZ=R*5.96-596.
44500	CC	END
44600	
44700	CF	SUBROUTINE RDRAW(I,S,XY,X,R3,CENTR,RMINI)
44800	C   TO X,Y INTO ONE WORD
44900	CF	DIMENSION XY(1)
45000	CF	DO 2 K=I,IFIX(S)
45100	CF	L=2
45200	CF	Y=XY(K)
45300	CF	IF(Y.LT.1000.)GO TO 3
45400	CF	L=3
45500	CF	Y=Y-1000.
45600	C   >1000 = INVIS. LINE
45700	CF3	M=Y
45800	CF	Y=(Y-M)*1000.
45900	CF	IF(Y.GT.100.)Y=100-Y
46000	C   Y NUMBERS .GT.100 ARE NEG.
46100	CF	B=Y*X+CENTR
46200	CF	IF(M.GT.60)M=100-M
46300	CF	A=M*RMINI+R3
46400	CF2	CALL LINES(A,B,L)
46500	CF	END
46600		
46700	CC	FUNCTION EEXP(X,Y)
46800	CC	EEXP=X**Y
46900	CC	END